home *** CD-ROM | disk | FTP | other *** search
/ Aminet 21 / Aminet 21 (1997)(GTI - Schatztruhe)[!][Oct 1997].iso / Aminet / gfx / show / gs503_data.lha / Ghostscript / data / wrfont.ps < prev    next >
Text File  |  1997-08-14  |  18KB  |  664 lines
  1. %    Copyright (C) 1991, 1995, 1996 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of Aladdin Ghostscript.
  4. % 
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. % 
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % wrfont.ps
  19. % Write out a Type 1 font in readable, reloadable form.
  20. % Note that this does NOT work on protected fonts, such as Adobe fonts
  21. % (unless you have loaded unprot.ps first, in which case you may be
  22. % violating the Adobe license).
  23.  
  24. % ****** NOTE: This file must be kept consistent with gs_pfile.ps.
  25.  
  26. /wrfont_dict 100 dict def
  27. wrfont_dict begin
  28.  
  29. % ------ Options ------ %
  30.  
  31. % Define whether to use eexec encryption for the font.
  32. % eexec encryption is only useful for compatibility with Adobe Type Manager
  33. % and other programs; it only slows Ghostscript down.
  34.    /eexec_encrypt false def
  35.  
  36. % Define whether to write out the CharStrings in binary or in hex.
  37. % Binary takes less space on the file, but isn't guaranteed portable.
  38.    /binary_CharStrings false def
  39.  
  40. % Define whether to use binary token encodings when possible.
  41. % Binary tokens are smaller and load faster, but are a Level 2 feature.
  42.    /binary_tokens false def
  43.  
  44. % Define whether to encrypt the CharStrings on the file.  (CharStrings
  45. % are always encrypted in memory.)  Unencrypted CharStrings load about
  46. % 20% slower, but make the files compress much better for transport.
  47.    /encrypt_CharStrings true def
  48.  
  49. % Define whether the font must provide standard PostScript language
  50. % equivalents for any facilities it uses that are provided in Ghostscript
  51. % but are not part of the standard PostScript language.
  52.    /standard_only true def
  53.  
  54. % Define the value of lenIV to use in writing out the font.
  55. % use_lenIV = 0 produces the smallest output, but this may not be
  56. % compatible with old Adobe interpreters.  use_lenIV = -1 means
  57. % use the value of lenIV from the font.
  58.    /use_lenIV -1 def
  59.  
  60. % Define whether to produce the smallest possible output, relying
  61. % as much as possible on Ghostscript-specific support code.
  62. % Taking full advantage of this requires the following settings:
  63. % binary_CharStrings = true, binary_tokens = true, standard_only = false.
  64.    /smallest_output false def
  65.  
  66. % Define whether to write out all currently known Encodings by name,
  67. % or only StandardEncoding and ISOLatin1Encoding.
  68.    /name_all_Encodings false def
  69.  
  70. % ---------------- Runtime support ---------------- %
  71.  
  72. /.packedfilefilter where
  73.  { pop }
  74.  { (gs_pfile.ps) runlibfile }
  75. ifelse
  76.  
  77. % ------ Output utilities ------ %
  78.  
  79. % By convention, the output file is named psfile.
  80.  
  81. % Define some utilities for writing the output file.
  82.    /wtstring 2000 string def
  83.    /wb {psfile exch write} bind def
  84.    /wnb {/wb load repeat} bind def
  85.    /w1 {psfile exch write} bind def
  86.    /ws {psfile exch writestring} bind def
  87.    /wl {ws (\n) ws} bind def
  88.    /wt {wtstring cvs ws ( ) ws} bind def
  89.    /wd        % Write a dictionary.
  90.     { dup length wo {dict dup begin} wol { we } forall
  91.       {end} wol
  92.     } bind def
  93.    /wld        % Write a large dictionary more efficiently.
  94.            % Ignore the readonly attributes.
  95.     { dup length wo {dict dup begin} wol
  96.       0 exch
  97.        { exch wo wo () wl
  98.      1 add dup 200 eq
  99.       { wo ({def} repeat) wl 0 }
  100.      if
  101.        }
  102.       forall
  103.       dup 0 ne
  104.        { wo ({def} repeat) wl }
  105.        { pop }
  106.       ifelse
  107.       (end) ws
  108.     } bind def
  109.    /we        % Write a dictionary entry.
  110.     { exch wo wo /def cvx wo (\n) ws
  111.     } bind def
  112.    /wcs        % Write a CharString (or Subrs entry)
  113.     { dup type /stringtype eq
  114.        { 4330 exch changelenIV 0 ge
  115.           {    % Add some leading garbage bytes.
  116.         wtstring changelenIV 2 index length getinterval
  117.         .type1decrypt exch pop
  118.         wtstring exch 0 exch length changelenIV add getinterval
  119.       }
  120.       {    % Drop some leading garbage bytes.
  121.         wtstring .type1decrypt exch pop
  122.         changelenIV neg 1 index length 1 index sub getinterval
  123.       }
  124.      ifelse
  125.          binary_tokens encrypt_CharStrings and
  126.       { % Suppress recognizing the readonly status of the string.
  127.         4330 exch dup .type1encrypt exch pop wo
  128.       }
  129.       { encrypt_CharStrings
  130.          { 4330 exch dup .type1encrypt exch pop
  131.          } if
  132.         smallest_output
  133.          { wo
  134.          }
  135.          { readonly dup length wo
  136.            binary_tokens not { ( ) ws } if
  137.            readproc ws wx
  138.          }
  139.         ifelse
  140.       }
  141.      ifelse
  142.        }
  143.        { wo        % PostScript procedure
  144.        }
  145.       ifelse
  146.     } bind def
  147.  
  148. % Construct the inversion of the system name table.
  149.    /SystemNames where
  150.     { pop /snit 256 dict def
  151.       0 1 255
  152.        { dup SystemNames exch get
  153.          dup null ne { exch snit 3 1 roll put } { pop pop } ifelse
  154.        }
  155.       for
  156.     }
  157.     { /snit 1 dict def
  158.     }
  159.    ifelse
  160.  
  161. % Write an object, using binary tokens if requested and possible.
  162.    /woa        % write in ascii
  163.     { psfile exch write==only
  164.     } bind def
  165.  
  166.             % Lookup table for ASCII output.
  167.  
  168.    /intbytes    % int nbytes -> byte*
  169.     { { dup 255 and exch -8 bitshift } repeat pop
  170.     } bind def
  171.    /wotta 10 dict dup begin
  172.       { /booleantype /integertype }
  173.       { { ( ) ws woa } def }
  174.      forall
  175.         % Iterate over arrays so we can print operators.
  176.      /arraytype
  177.       { dup xcheck {(}) ({)} {(]) ([)} ifelse ws exch dup wol exch ws wop
  178.       } bind def
  179.      /dicttype
  180.       { ( ) ws wd } def
  181.      /nametype
  182.       { dup xcheck { ( ) ws } if woa
  183.       } bind def
  184.         % Map back operators to their names,
  185.         % so we can write procedures.
  186.      /nulltype
  187.       { pop ( null) ws
  188.       } bind def
  189.      /operatortype
  190.       { wtstring cvs cvn cvx wo
  191.       } bind def
  192.         % Convert reals to integers if possible.
  193.      /realtype
  194.       { dup cvi 1 index eq { cvi wo } { ( ) ws woa } ifelse
  195.       } bind def
  196.         % == truncates strings longer than 200 characters!
  197.      /stringtype
  198.       { (\() ws dup
  199.      { dup dup 32 lt exch 127 ge or
  200.         { (\\) ws dup -6 bitshift 48 add w1
  201.           dup -3 bitshift 7 and 48 add w1
  202.           7 and 48 add
  203.         }
  204.         { dup dup -2 and 40 eq exch 92 eq or {(\\) ws} if
  205.         }
  206.        ifelse w1
  207.      }
  208.     forall
  209.     (\)) ws wop
  210.       } bind def
  211.      /packedarraytype
  212.       { ([) ws dup { wo } forall
  213.     encodingnames 1 index known
  214.         % This is an encoding, but not one of the standard ones.
  215.         % Use the built-in encoding only if it is available.
  216.      { encodingnames exch get wo
  217.        ({findencoding}stopped{pop) ws
  218.        (}{counttomark 1 add 1 roll cleartomark}ifelse)
  219.      }
  220.      { pop ()
  221.      }
  222.     ifelse
  223.     (/packedarray where{pop counttomark packedarray exch pop}{]readonly}ifelse) ws
  224.     wl
  225.       }
  226.      def
  227.    end def
  228.  
  229.             % Lookup table for binary output.
  230.  
  231.    /wottb 8 dict dup begin
  232.    wotta currentdict copy pop
  233.      /integertype
  234.       { dup dup 127 le exch -128 ge and
  235.          { 136 wb 255 and wb }
  236.      { dup dup 32767 le exch -32768 ge and
  237.         { 134 wb 2 intbytes wb wb }
  238.         { 132 wb 4 intbytes wb wb wb wb }
  239.        ifelse
  240.      }
  241.     ifelse
  242.       } bind def
  243.      /nametype
  244.       { dup snit exch known
  245.          { dup xcheck { 146 } { 145 } ifelse wb
  246.        snit exch get wb
  247.      }
  248.      { wotta /nametype get exec
  249.      }
  250.     ifelse
  251.       } bind def
  252.      /stringtype
  253.       { dup dup length dup 255 le { 142 2 } { 2 intbytes 143 3 } ifelse wnb
  254.     ws wop
  255.       } bind def
  256.    end def
  257.  
  258.    /wop        % Write object protection
  259.      { wcheck not { /readonly cvx wo } if
  260.      } bind def
  261.    /wo        % Write an object.
  262.      { dup type binary_tokens { wottb } { wotta } ifelse
  263.        exch get exec
  264.      } bind def
  265.    /wol        % Write a list of objects.
  266.      { { wo } forall
  267.      } bind def
  268.  
  269. % Write a hex string for Subrs or CharStrings.
  270.    /wx        % string ->
  271.     { binary_CharStrings
  272.        { ws
  273.        }
  274.        { % Some systems choke on very long lines, so
  275.      % we break up the hexstring into chunks of 50 characters.
  276.       { dup length 25 le {exit} if
  277.         dup 0 25 getinterval psfile exch writehexstring (\n) ws
  278.         dup length 25 sub 25 exch getinterval
  279.       } loop
  280.      psfile exch writehexstring
  281.        } ifelse
  282.     } bind def
  283.  
  284. % ------ CharString encryption utilities ------ %
  285.  
  286. /enc_dict 20 dict def
  287. 1 dict begin
  288. /bind { } def        % make sure we can print out the procedures
  289. enc_dict begin
  290.  
  291. (type1enc.ps) runlibfile
  292. enc_dict /.type1decrypt undef        % we don't need this
  293.  
  294. end end
  295.  
  296. enc_dict { 1 index where { pop pop pop } { def } ifelse } forall
  297.  
  298. % ------ Other utilities ------ %
  299.  
  300. % Test whether two values are equal (for default dictionary entries).
  301.    /valueeq        % <obj1> <obj2> valueeq <bool>
  302.     { 2 copy eq
  303.        { pop pop true }
  304.        {    % Special hack for comparing FontMatrix values
  305.      dup type /arraytype eq 2 index type /arraytype eq and
  306.       { dup length 2 index length eq
  307.          { true 0 1 3 index length 1 sub
  308.         {    % Stack: arr1 arr2 true index
  309.           3 index 1 index get 3 index 3 -1 roll get eq not
  310.            { pop false exit }
  311.           if
  312.         }
  313.            for 3 1 roll pop pop
  314.          }
  315.          { pop pop false
  316.          }
  317.         ifelse
  318.       }
  319.       { pop pop false
  320.       }
  321.      ifelse
  322.        }
  323.       ifelse
  324.     } bind def
  325.  
  326. % ------ The main program ------ %
  327.  
  328. % Define the dictionary of keys to skip because they are treated specially.
  329. /.fontskipkeys mark
  330.   /CharStrings dup
  331.   /Encoding dup
  332.   /FDepVector dup
  333.   /FID dup
  334.   /FontInfo dup
  335.   /Metrics dup
  336.   /Metrics2 dup
  337.   /Private dup
  338. .dicttomark def
  339. /.minfontskipkeys mark
  340.   .fontskipkeys { } forall
  341.   /FontName dup
  342.   /UniqueID dup
  343. .dicttomark def
  344. /.privateskipkeys mark
  345.   /ND dup
  346.   /NP dup
  347.   /RD dup
  348.   /Subrs dup
  349. .dicttomark def
  350. /.minprivateskipkeys mark
  351.   .privateskipkeys { } forall
  352.   /MinFeature dup
  353.   /Password dup
  354.   /UniqueID dup
  355. .dicttomark def
  356.  
  357. % Define the procedures for the Private dictionary.
  358. % These must be defined without `bind',
  359. % for the sake of the DISKFONTS feature.
  360. 4 dict begin
  361.  /-! {string currentfile exch readhexstring pop} def
  362.  /-| {string currentfile exch readstring pop} def
  363.  /|- {readonly def} def
  364.  /| {readonly put} def
  365. currentdict end /encrypted_procs exch def
  366. 4 dict begin
  367.  /-! {string currentfile exch readhexstring pop
  368.    4330 exch dup .type1encrypt exch pop} def
  369.  /-| {string currentfile exch readstring pop
  370.    4330 exch dup .type1encrypt exch pop} def
  371.  /|- {readonly def} def
  372.  /| {readonly put} def
  373. currentdict end /unencrypted_procs exch def
  374.  
  375. % Construct an inverse dictionary of encodings.
  376. /encodingnames mark
  377.  StandardEncoding /StandardEncoding
  378.  ISOLatin1Encoding /ISOLatin1Encoding
  379.  SymbolEncoding /SymbolEncoding
  380.  DingbatsEncoding /DingbatsEncoding
  381.  /resourceforall where
  382.   { pop (*) { cvn dup findencoding exch } 100 string /Encoding resourceforall }
  383.  if
  384. .dicttomark def
  385.  
  386. % Invert the standard encodings.
  387. .knownEncodings length 256 mul dict begin
  388.   0 .knownEncodings
  389.    {  { currentdict 1 index known { pop } { 1 index def } ifelse
  390.     1 add
  391.       }
  392.      forall
  393.    }
  394.   forall pop
  395. currentdict end /inverseencodings exch def
  396.  
  397. /writefont        % <psfile> writefont - (writes the current font)
  398.  { /psfile exch def
  399.    /Font currentfont def
  400.    /FontInfo Font /FontInfo .knownget not { 0 dict } if def
  401.    /FontType Font /FontType get def
  402.    /hasPrivate Font /Private known def
  403.    /Private hasPrivate { Font /Private get } { 0 dict } ifelse def
  404.    /readproc binary_CharStrings { (-| ) } { (-! ) } ifelse def
  405.    /privateprocs
  406.      encrypt_CharStrings binary_tokens not and
  407.       { encrypted_procs } { unencrypted_procs } ifelse
  408.      def
  409.    /addlenIV false def
  410.    /changelenIV use_lenIV 0 lt
  411.     { 0 }
  412.     { use_lenIV Private /lenIV .knownget not
  413.        { 4 /addlenIV use_lenIV 4 ne def } if sub }
  414.    ifelse def
  415.    /minimize
  416.      smallest_output
  417.      FontType 1 eq and
  418.      Font /UniqueID known and
  419.    def
  420.    (%!FontType) ws FontType wtstring cvs ws (-1.0: ) ws
  421.      currentfont /FontName get wt
  422.      FontInfo /version .knownget not { (001.001) } if wl
  423.    FontInfo /CreationDate .knownget { (%%Creation Date: ) ws wl } if
  424.    FontInfo /VMusage .knownget
  425.     { (%%VMusage: ) ws dup wt wtstring cvs wl }
  426.    if
  427.    (systemdict begin) wl
  428.  
  429. % If we're going to use eexec, create the filters now.
  430.    /realpsfile psfile def
  431.    eexec_encrypt
  432.     { /eexecfilter psfile binary_CharStrings not
  433.        { pop /bxstring 35 string def
  434.       { pop dup length 0 ne
  435.          { realpsfile exch writehexstring realpsfile (\n) writestring }
  436.          { pop }
  437.         ifelse bxstring
  438.       }
  439.      /NullEncode filter dup /hexfilter exch def
  440.        }
  441.       if 55665 /eexecEncode filter def
  442.     }
  443.    if
  444.  
  445. % Turn on binary tokens if relevant.
  446.    binary_tokens { (currentobjectformat 1 setobjectformat) wl } if
  447.  
  448. % If the file has a UniqueID, write out a check against loading it twice.
  449.    minimize
  450.     { Font /FontName get wo
  451.       Font /UniqueID get wo
  452.       Private length addlenIV { 1 add } if wo
  453.       Font length 1 add wo        % +1 for FontFile
  454.       ( .checkexistingfont) wl
  455.     }
  456.     { Font /UniqueID known
  457.        { ({} FontDirectory) ws Font /FontName get dup wo ( known) wl
  458.      ( {) ws wo ( findfont dup /UniqueID known) wl
  459.      (    { dup /UniqueID get) ws Font /UniqueID get wo ( eq exch /FontType get 1 eq and }) wl
  460.      (    { pop false } ifelse) wl
  461.      (    { pop save /restore load } if) wl
  462.      ( } if) wl
  463.        }
  464.       if
  465.     }
  466.    ifelse
  467.  
  468. % If we are writing unencrypted CharStrings for a standard environment,
  469. % write out the encryption procedures.
  470.    privateprocs unencrypted_procs eq standard_only and
  471.     { (systemdict /.type1encrypt known) wl
  472.       ( { save /restore load } { { } } ifelse) wl
  473.       (userdict begin) wl
  474.       enc_dict { we } forall
  475.       (end exec) wl
  476.     }
  477.    if
  478.  
  479. % Write out the creation of the font dictionary and FontInfo.
  480.    minimize not
  481.     { Font length 1 add wo {dict begin} wol        % +1 for FontFile
  482.     }
  483.    if
  484.    (/FontInfo ) ws FontInfo wd {readonly def} wol
  485.  
  486. % Write out the other fixed entries in the font dictionary.
  487.    Font begin
  488.    Font
  489.     { minimize
  490.        { .minfontskipkeys 2 index known
  491.       { pop pop
  492.       }
  493.       { //.compactfontdefault 2 index .knownget
  494.          { 1 index valueeq { pop pop } { we } ifelse }
  495.          { we }
  496.         ifelse
  497.       }
  498.      ifelse
  499.        }
  500.        { .fontskipkeys 2 index known { pop pop } { we } ifelse
  501.        }
  502.       ifelse
  503.     } forall
  504.    /Encoding
  505.    encodingnames Encoding known
  506.    name_all_Encodings
  507.    Encoding StandardEncoding eq or
  508.    Encoding ISOLatin1Encoding eq or and
  509.     { encodingnames Encoding get cvx }
  510.     { Encoding }
  511.    ifelse
  512.    dup /StandardEncoding cvx eq minimize and
  513.     { pop pop }
  514.     { we }
  515.    ifelse
  516.  
  517. % Write the FDepVector, if any.
  518.    Font /FDepVector .knownget
  519.     { {/FDepVector [} wol
  520.        { /FontName get wo {findfont} wol () wl } forall
  521.       {] readonly def} wol
  522.     }
  523.    if
  524.  
  525. % Write out the Metrics, if any.
  526.    Font /Metrics .knownget
  527.     { (/Metrics ) ws wld {readonly def} wol
  528.     }
  529.    if
  530.    Font /Metrics2 .knownget
  531.     { (/Metrics2 ) ws wld {readonly def} wol
  532.     }
  533.    if
  534.  
  535. % Start the eexec-encrypted section, if applicable.
  536.   eexec_encrypt
  537.    { {currentdict currentfile eexec} wol () wl
  538.      /psfile eexecfilter store
  539.      (\000\000\000\000) ws {begin} wol
  540.    }
  541.   if
  542.  
  543. % Create and initialize the Private dictionary, if any.
  544.    hasPrivate
  545. {
  546.    Private
  547.    minimize
  548.     { begin {Private dup begin}
  549.     }
  550.     {  dup length privateprocs length add dict copy begin
  551.        privateprocs { readonly def } forall
  552.        /Private wo
  553.        currentdict length 1 add wo {dict dup begin}
  554.     }
  555.    ifelse wol () wl
  556.    currentdict
  557.     { 1 index minimize { .minprivateskipkeys } { .privateskipkeys } ifelse
  558.       exch known
  559.        { pop pop }
  560.        { 1 index /lenIV eq use_lenIV 0 ge and { pop use_lenIV } if we }
  561.       ifelse
  562.     } forall
  563.    addlenIV { /lenIV use_lenIV we } if
  564. }
  565. if
  566.  
  567. % Write the Subrs entries, if any.
  568.    currentdict /Subrs known
  569.     { (/Subrs[) wl
  570.       Subrs
  571.        { dup null ne
  572.       { wcs minimize not { () wl } if }
  573.       { pop /null cvx wo }
  574.      ifelse
  575.        } forall
  576.       {] dup {readonly pop} forall readonly def} wol () wl
  577.     }
  578.    if
  579.  
  580. % Wrap up the Private dictionary.
  581.    hasPrivate
  582.     { end            % Private
  583.       minimize
  584.        { {end readonly pop} }    % Private
  585.        { {end readonly def} }    % Private in font
  586.       ifelse wol
  587.     }
  588.    if
  589.  
  590. % Write the CharStrings entries.
  591. % Detect identical (eq) entries, which bdftops produces.
  592.    currentdict /CharStrings known
  593. {
  594.    /CharStrings wo CharStrings length wo
  595.    minimize
  596.     { encrypt_CharStrings not wo ( .readCharStrings) wl
  597.       CharStrings length dict
  598.       CharStrings
  599.        { exch inverseencodings 1 index .knownget not { dup } if wo
  600.         % Stack: vdict value key
  601.      3 copy pop .knownget { wo pop pop } { 3 copy put pop wcs } ifelse
  602.        } forall
  603.     }
  604.     { {dict dup Private begin begin} wol () wl
  605.       CharStrings length dict
  606.       CharStrings
  607.        { 2 index 1 index known
  608.       { exch wo 1 index exch get wo {load def} wol () wl
  609.       }
  610.       { 2 index 1 index 3 index put
  611.         exch wo wcs ( |-) wl
  612.       }
  613.      ifelse
  614.        } forall
  615.       {end end} wol
  616.     }
  617.    ifelse
  618.    pop
  619.     { readonly def }    % CharStrings in font
  620.    wol
  621. }
  622. if
  623.  
  624. % Terminate the output.
  625.    end            % Font
  626.    eexec_encrypt
  627.     { {end mark currentfile closefile} wol () wl
  628.       eexecfilter dup flushfile closefile    % psfile is eexecfilter
  629.       binary_CharStrings not { hexfilter dup flushfile closefile } if
  630.       /psfile realpsfile store
  631.       8
  632.        { (0000000000000000000000000000000000000000000000000000000000000000)
  633.          wl
  634.        }
  635.       repeat {cleartomark} wol
  636.     }
  637.    if
  638.     { FontName currentdict end definefont pop
  639.     }
  640.    wol
  641.    Font /UniqueID known { /exec cvx wo } if
  642.    binary_tokens { /setobjectformat cvx wo } if
  643.    ( end) wl        % systemdict
  644.  
  645.  } bind def
  646.  
  647. % ------ Other utilities ------ %
  648.  
  649. % Prune garbage characters and OtherSubrs out of the current font,
  650. % if the relevant dictionaries are writable.
  651. /prunefont
  652.  { currentfont /CharStrings get wcheck
  653.     { currentfont /CharStrings get dup [ exch
  654.        { pop dup (S????00?) .stringmatch not { pop } if
  655.        } forall
  656.       ] { 2 copy undef pop } forall pop
  657.     }
  658.    if
  659.  } bind def
  660.  
  661. end            % wrfont_dict
  662.  
  663. /writefont { wrfont_dict begin writefont end } def
  664.